Unit BTestProjectManagerUnit;

{$mode objfpc}{$H+}

Interface

Uses
  Classes, SysUtils, BTestCaseInfoUnit, IniFiles, LiteLCLProc, BTemplatesUnit,
    BTestProjectRunnerUnit;

Type

{ BTestManagerClass }

 BTestManagerClass = Class
  Private
    bErrors: TStringList;
    bProjectFile: String;
    bProjectPath: String;

    bTestCases: BTestCasesList;
    bTestProject: String;
    bTestProjectIni: String;
    bTestProjectLpi: String;
    bTestProjectLpr: String;
    bTestProjectPath: String;

    bSearchPathes: String;
    bSpecialDerictives: String;

    bRunner: BTestRunnerClass;

    Function GetErrors: TStringList;
    Function GetFinished: Boolean;
    Function GetOutput: String;
    Function GetStatus: Integer;
    Function GetSuccessful: Boolean;
    Function GetTestCasesString: String;

    Procedure UpdateFiles;

    Procedure LoadTestCases;
    Procedure PurgeTestCases;
    Procedure FillSpecialParams(Const aSearchPathes,
      aSpecialDirectives: String);
  Public
    Property ProjectFile: String Read bProjectFile;
    Property ProjectPath: String Read bProjectPath;

    Property TestProject: String Read bTestProject;
    Property TestProjectLpi: String Read bTestProjectLpi;
    Property TestProjectLpr: String Read bTestProjectLpr;
    Property TestProjectIni: String Read bTestProjectIni;
    Property TestProjectPath: String Read bTestProjectPath;

    Property Status: Integer Read GetStatus;
    Property Output: String Read GetOutput;
    Property Errors: TStringList Read GetErrors;

    Property Finished: Boolean Read GetFinished;
    Property Successful: Boolean Read GetSuccessful;

    Procedure AddTestCase(Const aTestCase: String);
    Procedure RemoveTestCase(Const aTestCase: String);

    Function Run: Boolean;
    Function Run(Const aTestCaseFile: String;
      Const aIsTestName: Boolean = FALSE): Boolean;

    Procedure SetProject(Const aProjectFile, aSearchPathes,
      aSpecialDirectives: String);

    Constructor Build;
    Destructor Burn;
End;

Implementation

{ BTestManagerClass }

Function BTestManagerClass.GetTestCasesString: String;
Var
  i: Integer;
Begin
  Result := '';
  For i := 0 To bTestCases.Count - 1 Do
    Begin
      Result += bTestCases[i].UnitName + ', ';
    End;
End;

Function BTestManagerClass.GetStatus: Integer;
Begin
  Result := bRunner.Status;
end;

Function BTestManagerClass.GetSuccessful: Boolean;
Begin
  Result := Status = rsFinished;
end;

Function BTestManagerClass.GetOutput: String;
Begin
  Result := bRunner.Output;
end;

Function BTestManagerClass.GetErrors: TStringList;
Var
  aBuffer: TStringList;
  i: Integer;
Begin
  bErrors.Clear;
  aBuffer := TStringList.Create;
  aBuffer.Text := Output;
  For i := 0 To aBuffer.Count - 1 Do
    Begin
      If Pos('Failed:', aBuffer[i]) > 0 Then
        bErrors.Add(aBuffer[i]);
    End;
  aBuffer.Free;

  Result := bErrors;
end;

Function BTestManagerClass.GetFinished: Boolean;
Begin
  Result := Status In [rsFinished, rsFailed];
end;

Procedure BTestManagerClass.UpdateFiles;
Var
  i: Integer;
  aIniFile: TIniFile;
  aStringList: TStringList;
Begin
  If Not(DirectoryExists(bTestProjectPath)) Then
    Raise Exception.Create('Illegal test project path');
  aIniFile := TIniFile.Create(bTestProjectIni);
  aIniFile.EraseSection('TestCases');
  For i := 0 To bTestCases.Count - 1 Do
    aIniFile.WriteBool('TestCases', bTestCases[i].FilePath, TRUE);
  aIniFile.Free;

  aStringList := TStringList.Create;
  aStringList.Text := Format(TEMPLATE_LPI,
    [LineEnding, ExtractFileName(bTestProjectLpr),
      ExtractFileName(bTestProject), bSearchPathes, bSpecialDerictives]);
  aStringList.SaveToFile(bTestProjectLpi);

  aStringList.Clear;
  aStringList.Text := Format(TEMPLATE_LPR,
    [LineEnding, ExtractFileNameOnly(bTestProject), GetTestCasesString]);
  aStringList.SaveToFile(bTestProjectLpr);
  aStringList.Free;
End;

Procedure BTestManagerClass.LoadTestCases;
Var
  aIniFile: TIniFile;
  aTestCases: TStringList;
  i: Integer;
Begin
  PurgeTestCases;
  aIniFile := TIniFile.Create(bTestProjectIni);
  aTestCases := TStringList.Create;
  aIniFile.ReadSection('TestCases', aTestCases);

  For i := 0 To aTestCases.Count - 1 Do
    AddTestCase(aTestCases[i]);

  aTestCases.Free;
  aIniFile.Free;
End;

Procedure BTestManagerClass.PurgeTestCases;
Var
  i: Integer;
Begin
  For i := 0 To bTestCases.Count - 1 Do
    bTestCases[i].Burn;
  bTestCases.Clear;
End;

Procedure BTestManagerClass.FillSpecialParams(Const aSearchPathes,
  aSpecialDirectives: String);
Var
  aPathes: String;
  aPath: String;
Begin
  bSearchPathes := '';
  aPathes := aSearchPathes;
  While Not(aPathes = '') Do
    Begin
      If Pos(';', aPathes) > 0 Then
        Begin
          aPath := Copy(aPathes, 1, Pos(';',  aPathes) - 1);
          Delete(aPathes, 1, Pos(';', aPathes));
        End
      Else
        Begin
          aPath := aPathes;
          aPathes := '';
        End;

      If FilenameIsAbsolute(aPath) Or (Pos('$', aPath) = 1) Then
        bSearchPathes += aPath + ';'
      Else
        bSearchPathes += Format('..%s%s;', [PathDelim, aPath]);
    End;

  bSpecialDerictives := aSpecialDirectives;
End;

Procedure BTestManagerClass.SetProject(Const aProjectFile, aSearchPathes,
  aSpecialDirectives: String);
Begin
  If Not(FileExists(aProjectFile)) Then
    Raise Exception.Create('There is not file');

  If bProjectFile = aProjectFile Then Exit;

  bProjectFile := aProjectFile;
  bProjectPath := ExtractFilePath(bProjectFile);

  bTestProjectPath :=
    bProjectPath + 'Tests' + DirectorySeparator;
  If Not(DirectoryExists(bTestProjectPath)) Then
    MkDir(bTestProjectPath);
  bTestProjectIni := bTestProjectPath + 'tests.ini';

  bTestProject := bTestProjectPath + ExtractFileNameOnly(bProjectFile) +
    'Test';
  bTestProjectLpi := bTestProject + '.lpi';
  bTestProjectLpr := bTestProject + '.lpr';

  LoadTestCases;
  FillSpecialParams(aSearchPathes, aSpecialDirectives);

  UpdateFiles;
End;

Procedure BTestManagerClass.AddTestCase(Const aTestCase: String);
Begin
  RemoveTestCase(aTestCase);
  bTestCases.Add(BTestCaseInfoClass.Build(aTestCase));
  UpdateFiles;
End;

Procedure BTestManagerClass.RemoveTestCase(Const aTestCase: String);
Var
  i: Integer;
Begin
  For i := 0 To bTestCases.Count - 1 Do
    If bTestCases[i].FilePath = aTestCase Then
      Begin
        bTestCases[i].Burn;
        bTestCases.Delete(i);
        Break;
      End;
  UpdateFiles;
End;

Function BTestManagerClass.Run: Boolean;
Begin
  Result := bRunner.Prepare;
  If Result Then
    bRunner.Run(TestProjectLpr);
End;

Function BTestManagerClass.Run(Const aTestCaseFile: String;
  Const aIsTestName: Boolean): Boolean;
Begin
  Result := bRunner.Prepare;
  If Result Then
    bRunner.Run(TestProjectLpr, aTestCaseFile, aIsTestName);
End;

Constructor BTestManagerClass.Build;
Begin
  bTestCases := BTestCasesList.Build;
  bRunner := BTestRunnerClass.Build;
  bErrors := TStringList.Create;
End;

Destructor BTestManagerClass.Burn;
Begin
  bErrors.Free;
  bRunner.Burn;
  PurgeTestCases;
  bTestCases.Burn;
End;

End.

